home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / COLORP~1.FRM < prev    next >
Text File  |  1997-06-14  |  8KB  |  285 lines
  1. VERSION 5.00
  2. Begin VB.Form FColorPicker 
  3.    BackColor       =   &H00FFFFFF&
  4.    BorderStyle     =   1  'Fixed Single
  5.    ClientHeight    =   1128
  6.    ClientLeft      =   4788
  7.    ClientTop       =   6072
  8.    ClientWidth     =   4260
  9.    ControlBox      =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   94
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   355
  17.    Begin VB.Image imgPalette 
  18.       Height          =   636
  19.       Left            =   672
  20.       Picture         =   "colorpicker.frx":0000
  21.       Top             =   1932
  22.       Width           =   3276
  23.    End
  24. End
  25. Attribute VB_Name = "FColorPicker"
  26. Attribute VB_GlobalNameSpace = False
  27. Attribute VB_Creatable = False
  28. Attribute VB_PredeclaredId = True
  29. Attribute VB_Exposed = False
  30. Option Explicit
  31.  
  32. Private aColor() As OLE_COLOR
  33. Private clrCur As OLE_COLOR, clrLast As OLE_COLOR
  34. Private fWide As Boolean, fDragging As Boolean
  35. Private ixCur As Long, iyCur As Long, ixMax As Long, iyMax As Long
  36. Private ix As Long, iy As Long, ixStart As Long, iyStart As Long
  37.  
  38. Private Sub Form_Initialize()
  39.     ' Defaults if no one assigns different
  40.     Wide = False
  41.     Color = vbWhite
  42. End Sub
  43.  
  44. Private Sub Form_Load()
  45.     ' Set the form width and height exactly
  46.     clrLast = clrCur
  47. End Sub
  48.  
  49. Private Sub Form_Resize()
  50.     ' Set the form width and height exactly
  51.     Move Left, Top, ScaleX((ixMax * 17) + 3, vbPixels, vbTwips), _
  52.          ScaleY((iyMax * 17) + 3, vbPixels, vbTwips)
  53.     Refresh
  54. End Sub
  55.  
  56. Private Sub Form_Paint()
  57.     Dim ix As Long, iy As Long
  58.     ' Draw colors in their boxes
  59.     FillStyle = vbSolid
  60.     For ix = 1 To ixMax
  61.         For iy = 1 To iyMax
  62.             FillColor = aColor(ix, iy)
  63.             Line (((ix - 1) * 17) + 1, _
  64.                   ((iy - 1) * 17) + 1)-Step(15, 15), , B
  65.         Next
  66.     Next
  67.     DrawSelection ixCur, iyCur, True
  68. End Sub
  69.  
  70. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
  71.                            X As Single, Y As Single)
  72.     DrawSelection ixCur, iyCur, False
  73.     ' Calculate the current position
  74.     ixCur = ((X + 1) \ 17) + 1
  75.     iyCur = ((Y + 1) \ 17) + 1
  76.     If ixCur > ixMax Then ixCur = ixMax
  77.     If iyCur > iyMax Then iyCur = iyMax
  78.     fDragging = True
  79.     DrawSelection ixCur, iyCur, True
  80. End Sub
  81.  
  82. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
  83.                            X As Single, Y As Single)
  84.     ' Calculate the current position
  85.     Dim ix As Long, iy As Long
  86.     ix = ((X + 1) \ 17) + 1
  87.     iy = ((Y + 1) \ 17) + 1
  88.     If ix > ixMax Then ix = ixMax
  89.     If iy > iyMax Then iy = iyMax
  90.     If fDragging Then
  91.         DrawSelection ixCur, iyCur, False
  92.         ixCur = ix: iyCur = iy
  93.         DrawSelection ixCur, iyCur, True
  94.     End If
  95. End Sub
  96.  
  97. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
  98.                          X As Single, Y As Single)
  99.     If Button = 2 Then
  100.         Color = clrLast
  101.     Else
  102.         clrCur = aColor(ixCur, iyCur)
  103.         FillColor = clrCur
  104.         fDragging = False
  105.     End If
  106.     Unload Me
  107. End Sub
  108.  
  109. Private Sub Form_KeyPress(KeyAscii As Integer)
  110.     If KeyAscii = 27 Then
  111.         Color = clrLast
  112.         Unload Me
  113.     End If
  114. End Sub
  115.  
  116. Friend Property Get Color() As OLE_COLOR
  117.     Color = clrCur
  118. End Property
  119.  
  120. Friend Property Let Color(clrCurA As OLE_COLOR)
  121.     Dim ix As Long, iy As Long
  122.     For ix = 1 To ixMax
  123.         For iy = 1 To iyMax
  124.             If aColor(ix, iy) = clrCurA Then
  125.                 ixCur = ix: iyCur = iy
  126.                 clrCur = clrCurA
  127.                 If ixCur Then Form_Paint
  128.                 Exit Property
  129.             End If
  130.         Next
  131.     Next
  132. End Property
  133.  
  134. Friend Property Get Wide() As Boolean
  135.     Wide = fWide
  136. End Property
  137.  
  138. Friend Property Let Wide(fWideA As Boolean)
  139.     Dim clr As OLE_COLOR
  140.     fWide = fWideA
  141.     If fWide Then
  142.         ixMax = 16
  143.         iyMax = 3
  144.     Else
  145.         ixMax = 8
  146.         iyMax = 6
  147.     End If
  148.     clr = Color
  149.     InitArray
  150.     Color = clr
  151.     Form_Resize
  152. End Property
  153.  
  154. Sub DrawSelection(ByVal ix As Long, ByVal iy As Long, fSelect As Boolean)
  155.     ' Box the selection
  156.     If ix = 0 And iy = 0 Then Exit Sub
  157.     Dim ordFillStyle As FillStyleConstants
  158.     ordFillStyle = FillStyle
  159.     FillStyle = vbTransparent
  160.     FillColor = aColor(ix, iy)
  161.     If fSelect Then
  162.         Line (((ix - 1) * 17) + 1, _
  163.               ((iy - 1) * 17) + 1)-Step(15, 15), vbBlack, B
  164.         Line (((ix - 1) * 17), _
  165.               ((iy - 1) * 17))-Step(16, 16), vbWhite, B
  166.         Line (((ix - 1) * 17) + 1, _
  167.               ((iy - 1) * 17) + 1)-Step(14, 14), vbBlack, B
  168.     Else
  169.         Line (((ix - 1) * 17), _
  170.               ((iy - 1) * 17))-Step(16, 16), vbButtonFace, B
  171.         Line (((ix - 1) * 17) + 1, _
  172.               ((iy - 1) * 17) + 1)-Step(15, 15), , B
  173.     End If
  174.     FillStyle = ordFillStyle
  175. End Sub
  176.  
  177. Sub InitArray()
  178.     ReDim aColor(1 To ixMax, 1 To iyMax) As Long
  179.     If fWide Then
  180.         aColor(1, 1) = &HFFFFFF
  181.         aColor(1, 2) = &HC0C0C0
  182.         aColor(1, 3) = &H808080
  183.         aColor(2, 1) = &HE0E0E0
  184.         aColor(2, 2) = &H404040
  185.         aColor(2, 3) = &H0
  186.         aColor(3, 1) = &HC0C0FF
  187.         aColor(3, 2) = &H8080FF
  188.         aColor(3, 3) = &HFF&
  189.         aColor(4, 1) = &HC0E0FF
  190.         aColor(4, 2) = &H80C0FF
  191.         aColor(4, 3) = &H80FF&
  192.         aColor(5, 1) = &HC0FFFF
  193.         aColor(5, 2) = &H80FFFF
  194.         aColor(5, 3) = &HFFFF&
  195.         aColor(6, 1) = &HC0FFC0
  196.         aColor(6, 2) = &H80FF80
  197.         aColor(6, 3) = &HFF00&
  198.         aColor(7, 1) = &HFFFFC0
  199.         aColor(7, 2) = &HFFFF80
  200.         aColor(7, 3) = &HFFFF00
  201.         aColor(8, 1) = &HFFC0C0
  202.         aColor(8, 2) = &HFF8080
  203.         aColor(8, 3) = &HFF0000
  204.         aColor(9, 1) = &HFFC0FF
  205.         aColor(9, 2) = &HFF80FF
  206.         aColor(9, 3) = &HFF00FF
  207.         aColor(10, 1) = &HC0&
  208.         aColor(10, 2) = &H80&
  209.         aColor(10, 3) = &H40&
  210.         aColor(11, 1) = &H40C0&
  211.         aColor(11, 2) = &H4080&
  212.         aColor(11, 3) = &H404080
  213.         aColor(12, 1) = &HC0C0&
  214.         aColor(12, 2) = &H8080&
  215.         aColor(12, 3) = &H4040&
  216.         aColor(13, 1) = &HC000&
  217.         aColor(13, 2) = &H8000&
  218.         aColor(13, 3) = &H4000&
  219.         aColor(14, 1) = &HC0C000
  220.         aColor(14, 2) = &H808000
  221.         aColor(14, 3) = &H404000
  222.         aColor(15, 1) = &HC00000
  223.         aColor(15, 2) = &H800000
  224.         aColor(15, 3) = &H400000
  225.         aColor(16, 1) = &HC000C0
  226.         aColor(16, 2) = &H800080
  227.         aColor(16, 3) = &H400040
  228.     Else
  229.         ' Initialize color array
  230.         aColor(1, 1) = &HFFFFFF
  231.         aColor(1, 2) = &HE0E0E0
  232.         aColor(1, 3) = &HC0C0C0
  233.         aColor(1, 4) = &H808080
  234.         aColor(1, 5) = &H404040
  235.         aColor(1, 6) = &H0&
  236.         aColor(2, 1) = &HC0C0FF
  237.         aColor(2, 2) = &H8080FF
  238.         aColor(2, 3) = &HFF&
  239.         aColor(2, 4) = &HC0&
  240.         aColor(2, 5) = &H80
  241.         aColor(2, 6) = &H40
  242.         aColor(3, 1) = &HC0E0FF
  243.         aColor(3, 2) = &H80C0FF
  244.         aColor(3, 3) = &H80FF&
  245.         aColor(3, 4) = &H40C0&
  246.         aColor(3, 5) = &H4080&
  247.         aColor(3, 6) = &H404080
  248.         aColor(4, 1) = &HC0FFFF
  249.         aColor(4, 2) = &H80FFFF
  250.         aColor(4, 3) = &HFFFF&
  251.         aColor(4, 4) = &HC0C0&
  252.         aColor(4, 5) = &H8080&
  253.         aColor(4, 6) = &H4040&
  254.         aColor(5, 1) = &HC0FFC0
  255.         aColor(5, 2) = &H80FF80
  256.         aColor(5, 3) = &HFF00&
  257.         aColor(5, 4) = &HC000&
  258.         aColor(5, 5) = &H8000&
  259.         aColor(5, 6) = &H4000&
  260.         aColor(6, 1) = &HFFFFC0
  261.         aColor(6, 2) = &HFFFF80
  262.         aColor(6, 3) = &HFFFF00
  263.         aColor(6, 4) = &HC0C000
  264.         aColor(6, 5) = &H808000
  265.         aColor(6, 6) = &H404000
  266.         aColor(7, 1) = &HFFC0C0
  267.         aColor(7, 2) = &HFF8080
  268.         aColor(7, 3) = &HFF0000
  269.         aColor(7, 4) = &HC00000
  270.         aColor(7, 5) = &H800000
  271.         aColor(7, 6) = &H400000
  272.         aColor(8, 1) = &HFFC0FF
  273.         aColor(8, 2) = &HFF80FF
  274.         aColor(8, 3) = &HFF00FF
  275.         aColor(8, 4) = &HC000C0
  276.         aColor(8, 5) = &H800080
  277.         aColor(8, 6) = &H400040
  278.     End If
  279. End Sub
  280.  
  281.  
  282.  
  283.  
  284.  
  285.